home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpmulti.zip
/
QUETEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
2KB
|
103 lines
{$R-,S-,I-,D-,F-,V-,B-,N-,L- }
PROGRAM QueueTest;
{
Demonstration: QUEUE.TPU
Autor: Christian Philipps
Düsseldorfer Str. 316
4130 Moers 1
}
USES Queue;
TYPE MyRecType = RECORD
Num : Byte;
T : String;
END;
MyPtrType = ^MyRecType;
VAR MyQueue : QueueType;
MyPtr : MyPtrType;
Work : String;
Count : Byte;
n : Byte;
{$F+}
FUNCTION Compare(V,D:Pointer):BOOLEAN;
VAR BPtr : ^Byte absolute V;
MPtr : MyPtrType absolute D;
BEGIN {Compare}
Compare := (MPtr^.Num = BPtr^);
END; {Compare}
{$F-}
{$F+}
FUNCTION Compare1(V,D:Pointer):BOOLEAN;
VAR SPtr : ^String absolute V;
MPtr : MyPtrType absolute D;
BEGIN {Compare1}
Compare1 := (MPtr^.T = SPtr^);
END; {Compare1}
{$F-}
PROCEDURE DisplayQueue;
VAR n : Byte;
z : MyPtrType;
BEGIN {DisplayQueue}
FOR n := 1 TO Count DO
BEGIN
z := MyPtrType(FindRec(MyQueue,@n,Compare));
IF z <> NIL
THEN Writeln(z^.Num:3,' ',z^.T);
END;
END; {DisplayQueue}
BEGIN {Main}
Count := 0;
CreQueue(MyQueue);
REPEAT
Write('Please input Text: ');
Readln(Work);
IF Byte(Work[0]) > 0
THEN BEGIN
New(MyPtr);
Inc(Count);
WITH MyPtr^ DO
BEGIN
T := Work;
Num := Count;
END;
AppendRec(MyQueue,MyPtr);
END;
UNTIL Byte(Work[0]) = 0;
Writeln('You have input ',Count,' elements!');
Writeln('Here they are...');
DisplayQueue;
Writeln;
Writeln('Deletion of single Elements:');
REPEAT
Write('Delete element (enter text): ');
Readln(Work);
IF Byte(Work[0]) > 0
THEN BEGIN
MyPtr := MyPtrType(FindRec(MyQueue,@Work,Compare1));
IF MyPtr = NIL
THEN Writeln('Element not found!')
ELSE BEGIN
IF RemoveRec(MyQueue,MyPtr) = NIL THEN;
Dispose(MyPtr);
DisplayQueue;
Writeln;
END;
END;
UNTIL Byte(Work[0]) = 0;
END. {Main}